home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / compiler / cgai386.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-09-24  |  49.8 KB  |  1,291 lines
  1. {
  2.     $Id: cgai386.pas,v 1.4.2.1 1998/04/09 23:29:23 peter Exp $
  3.     Copyright (c) 1993-98 by Florian Klaempfl
  4.  
  5.     This unit generates i386 (or better) assembler from the parse tree
  6.  
  7.     This program is free software; you can redistribute it and/or modify
  8.     it under the terms of the GNU General Public License as published by
  9.     the Free Software Foundation; either version 2 of the License, or
  10.     (at your option) any later version.
  11.  
  12.     This program is distributed in the hope that it will be useful,
  13.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15.     GNU General Public License for more details.
  16.  
  17.     You should have received a copy of the GNU General Public License
  18.     along with this program; if not, write to the Free Software
  19.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.  ****************************************************************************}
  22.  
  23. unit cgai386;
  24.  
  25.   interface
  26.  
  27.     uses
  28.        objects,cobjects,systems,globals,tree,symtable,types,strings,
  29.        pass_1,hcodegen,aasm,i386,tgeni386,files,verbose
  30. {$ifdef GDB}
  31.        ,gdb
  32. {$endif GDB}
  33.        ;
  34.  
  35.     procedure emitl(op : tasmop;var l : plabel);
  36.     procedure emit_reg_reg(i : tasmop;s : topsize;reg1,reg2 : tregister);
  37.     procedure emitcall(const routine:string;add_to_externals : boolean);
  38.      procedure emitloadord2reg(location:Tlocation;orddef:Porddef;
  39.                               destreg:Tregister;delloc:boolean);
  40.     { produces jumps to true respectively false labels using boolean expressions }
  41.     procedure maketojumpbool(p : ptree);
  42.     procedure emitoverflowcheck(p:ptree);
  43.     procedure push_int(l : longint);
  44.     function maybe_push(needed : byte;p : ptree) : boolean;
  45.     procedure restore(p : ptree);
  46.     procedure emit_push_mem(const ref : treference);
  47.     procedure emitpushreferenceaddr(const ref : treference);
  48.      procedure swaptree(p:Ptree);
  49.     procedure copystring(const dref,sref : treference;len : byte);
  50.     procedure loadstring(p:ptree);
  51.     procedure concatcopy(source,dest : treference;size : longint;delsource : boolean);
  52.     { see implementation }
  53.     procedure maybe_loadesi;
  54.  
  55.     procedure floatload(t : tfloattype;const ref : treference);
  56.     procedure floatstore(t : tfloattype;const ref : treference);
  57.     procedure floatloadops(t : tfloattype;var op : tasmop;var s : topsize);
  58.     procedure floatstoreops(t : tfloattype;var op : tasmop;var s : topsize);
  59.  
  60.     procedure firstcomplex(p : ptree);
  61.     procedure secondfuncret(var p : ptree);
  62.  
  63.     { initialize respectively terminates the code generator }
  64.     { for a new module or procedure                         }
  65.     procedure codegen_doneprocedure;
  66.     procedure codegen_donemodule;
  67.     procedure codegen_newmodule;
  68.     procedure codegen_newprocedure;
  69.  
  70.     { generate entry code for a procedure.}
  71.     procedure genentrycode(const proc_names:Tstringcontainer;make_global:boolean;
  72.                            stackframe:longint;
  73.                            var parasize:longint;var nostackframe:boolean);
  74.     { generate the exit code for a procedure. }
  75.     procedure genexitcode(parasize:longint;nostackframe:boolean);
  76.  
  77.   implementation
  78.  
  79.     {
  80.     procedure genconstadd(size : topsize;l : longint;const str : string);
  81.  
  82.       begin
  83.          if l=0 then
  84.          else if l=1 then
  85.            exprasmlist^.concat(new(pai386,op_A_INC,size,str)
  86.          else if l=-1 then
  87.            exprasmlist^.concat(new(pai386,op_A_INC,size,str)
  88.          else
  89.            exprasmlist^.concat(new(pai386,op_ADD,size,'$'+tostr(l)+','+str);
  90.       end;
  91.     }
  92.  
  93.     procedure copystring(const dref,sref : treference;len : byte);
  94.  
  95.       var
  96.          pushed : tpushed;
  97.  
  98.       begin
  99.          emitpushreferenceaddr(dref);
  100.          emitpushreferenceaddr(sref);
  101.          push_int(len);
  102.          emitcall('STRCOPY',true);
  103.          maybe_loadesi;
  104.       end;
  105.  
  106.     procedure loadstring(p:ptree);
  107.       begin
  108.         case p^.right^.resulttype^.deftype of
  109.          stringdef : begin
  110.                        if (p^.right^.treetype=stringconstn) and
  111.                           (p^.right^.values^='') then
  112.                         exprasmlist^.concat(new(pai386,op_const_ref(
  113.                            A_MOV,S_B,0,newreference(p^.left^.location.reference))))
  114.                        else
  115.                         copystring(p^.left^.location.reference,p^.right^.location.reference,
  116.                            min(pstringdef(p^.right^.resulttype)^.len,pstringdef(p^.left^.resulttype)^.len));
  117.                      end;
  118.             orddef : begin
  119.                        if p^.right^.treetype=ordconstn then
  120.                          exprasmlist^.concat(new(pai386,op_const_ref(
  121.                             A_MOV,S_W,p^.right^.value*256+1,newreference(p^.left^.location.reference))))
  122.                        else
  123.                          begin
  124.                             { not so elegant (goes better with extra register }
  125.                             if (p^.right^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  126.                               begin
  127.                                  exprasmlist^.concat(new(pai386,op_reg_reg(
  128.                                     A_MOV,S_L,reg8toreg32(p^.right^.location.register),R_EDI)));
  129.                                  ungetregister32(reg8toreg32(p^.right^.location.register));
  130.                               end
  131.                             else
  132.                               begin
  133.                                  exprasmlist^.concat(new(pai386,op_ref_reg(
  134.                                     A_MOV,S_L,newreference(p^.right^.location.reference),R_EDI)));
  135.                                  del_reference(p^.right^.location.reference);
  136.                               end;
  137.                             exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,8,R_EDI)));
  138.                             exprasmlist^.concat(new(pai386,op_const_reg(A_OR,S_L,1,R_EDI)));
  139.                             exprasmlist^.concat(new(pai386,op_reg_ref(
  140.                                A_MOV,S_W,R_DI,newreference(p^.left^.location.reference))));
  141.                          end;
  142.                      end;
  143.         else
  144.          Message(sym_e_type_mismatch);
  145.         end;
  146.       end;
  147.  
  148.  
  149.     procedure restore(p : ptree);
  150.  
  151.       var
  152.          hregister :  tregister;
  153.  
  154.       begin
  155.          hregister:=getregister32;
  156.          exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,hregister)));
  157.          if (p^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  158.           p^.location.register:=hregister
  159.          else
  160.            begin
  161.               reset_reference(p^.location.reference);
  162.               p^.location.reference.index:=hregister;
  163.               set_location(p^.left^.location,p^.location);
  164.            end;
  165.       end;
  166.  
  167.     function maybe_push(needed : byte;p : ptree) : boolean;
  168.  
  169.       var
  170.          pushed : boolean;
  171.          {hregister : tregister; }
  172.  
  173.       begin
  174.          if needed>usablereg32 then
  175.            begin
  176.               if (p^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  177.                 begin
  178.                    pushed:=true;
  179.                    exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.location.register)));
  180.                    ungetregister32(p^.location.register);
  181.                 end
  182.               else if (p^.location.loc in [LOC_MEM,LOC_REFERENCE]) and
  183.                       ((p^.location.reference.base<>R_NO) or
  184.                        (p^.location.reference.index<>R_NO)
  185.                       ) then
  186.                   begin
  187.                      del_reference(p^.location.reference);
  188.                      exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(p^.location.reference),
  189.                        R_EDI)));
  190.                      exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EDI)));
  191.                      pushed:=true;
  192.                   end
  193.               else pushed:=false;
  194.            end
  195.          else pushed:=false;
  196.          maybe_push:=pushed;
  197.       end;
  198.  
  199.     procedure emitl(op : tasmop;var l : plabel);
  200.  
  201.       begin
  202.          if op=A_LABEL then
  203.            exprasmlist^.concat(new(pai_label,init(l)))
  204.          else
  205.            exprasmlist^.concat(new(pai_labeled,init(op,l)))
  206.       end;
  207.  
  208.     procedure emit_reg_reg(i : tasmop;s : topsize;reg1,reg2 : tregister);
  209.  
  210.       begin
  211.          if (reg1<>reg2) or (i<>A_MOV) then
  212.            exprasmlist^.concat(new(pai386,op_reg_reg(i,s,reg1,reg2)));
  213.       end;
  214.  
  215.     procedure emitcall(const routine:string;add_to_externals : boolean);
  216.  
  217.      begin
  218.         exprasmlist^.concat(new(pai386,op_csymbol(A_CALL,S_NO,newcsymbol(routine,0))));
  219.         if assem_need_external_list and add_to_externals and
  220.            not (cs_compilesystem in aktswitches) then
  221.           concat_external(routine,EXT_NEAR);
  222.      end;
  223.  
  224.     procedure maketojumpbool(p : ptree);
  225.  
  226.       begin
  227.          if p^.error then
  228.            exit;
  229.          if (p^.resulttype^.deftype=orddef) and
  230.             (porddef(p^.resulttype)^.typ=bool8bit) then
  231.            begin
  232.               if is_constboolnode(p) then
  233.                 begin
  234.                    if p^.value<>0 then
  235.                      emitl(A_JMP,truelabel)
  236.                    else emitl(A_JMP,falselabel);
  237.                 end
  238.               else
  239.                 begin
  240.                    case p^.location.loc of
  241.                       LOC_CREGISTER,LOC_REGISTER : begin
  242.                                         exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_B,p^.location.register,
  243.                                           p^.location.register)));
  244.                                         ungetregister32(reg8toreg32(p^.location.register));
  245.                                         emitl(A_JNZ,truelabel);
  246.                                         emitl(A_JMP,falselabel);
  247.                                      end;
  248.                       LOC_MEM,LOC_REFERENCE : begin
  249.                                         exprasmlist^.concat(new(pai386,op_const_ref(
  250.                                           A_CMP,S_B,0,newreference(p^.location.reference))));
  251.                                         del_reference(p^.location.reference);
  252.                                         emitl(A_JNZ,truelabel);
  253.                                         emitl(A_JMP,falselabel);
  254.                                      end;
  255.                       LOC_FLAGS : begin
  256.                                      emitl(flag_2_jmp[p^.location.resflags],truelabel);
  257.                                      emitl(A_JMP,falselabel);
  258.                                   end;
  259.                    end;
  260.                 end;
  261.            end
  262.          else
  263.            Message(sym_e_type_mismatch);
  264.       end;
  265.  
  266.     procedure emitoverflowcheck(p:ptree);
  267.  
  268.       var
  269.          hl : plabel;
  270.  
  271.       begin
  272.          if cs_check_overflow in aktswitches  then
  273.            begin
  274.               getlabel(hl);
  275.               if not ((p^.resulttype^.deftype=pointerdef) or
  276.                      ((p^.resulttype^.deftype=orddef) and
  277.                 (porddef(p^.resulttype)^.typ in [u16bit,u32bit,u8bit,uchar,bool8bit]))) then
  278.                 emitl(A_JNO,hl)
  279.               else
  280.                 emitl(A_JNB,hl);
  281.               emitcall('RE_OVERFLOW',true);
  282.               emitl(A_LABEL,hl);
  283.            end;
  284.       end;
  285.  
  286.     procedure push_int(l : longint);
  287.  
  288.       begin
  289.          if (opt_processors<>globals.i386) and not(cs_littlesize in aktswitches) then
  290.            begin
  291.               if l=0 then
  292.                 begin
  293.                    exprasmlist^.concat(new(pai386,op_reg_reg(
  294.                      A_XOR,S_L,R_EDI,R_EDI)));
  295.                    exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EDI)));
  296.                 end
  297.               else
  298.                 exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,l)));
  299.            end
  300.          else
  301.             exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,l)));
  302.       end;
  303.  
  304.     procedure emit_push_mem(const ref : treference);
  305.  
  306.       begin
  307.          if ref.isintvalue then
  308.            push_int(ref.offset)
  309.          else
  310.            begin
  311.               if (opt_processors<>globals.i386) and not(cs_littlesize in aktswitches) then
  312.                 begin
  313.                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(ref),R_EDI)));
  314.                    exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EDI)));
  315.                 end
  316.               else exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,newreference(ref))));
  317.            end;
  318.       end;
  319.  
  320.     procedure emitpushreferenceaddr(const ref : treference);
  321.  
  322.       var href : treference;
  323.       begin
  324.          { this will fail for references to other segments !!! }
  325.          if ref.isintvalue then
  326.          { is this right ? }
  327.            begin
  328.               { push_int(ref.offset)}
  329.               gettempofsizereference(4,href);
  330.               exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_L,ref.offset,newreference(href))));
  331.               emitpushreferenceaddr(href);
  332.               del_reference(href);
  333.               {internalerror(11111); for test }
  334.               { this temp will be lost ?! }
  335.            end
  336.          else
  337.            begin
  338.               if ref.segment<>R_DEFAULT_SEG then
  339.                 Message(cg_e_cant_use_far_pointer_there);
  340.               if (ref.base=R_NO) and (ref.index=R_NO) then
  341.                 exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,newcsymbol(ref.symbol^,ref.offset))))
  342.               else if (ref.base=R_NO) and (ref.index<>R_NO) and
  343.                  (ref.offset=0) and (ref.scalefactor=0) and (ref.symbol=nil) then
  344.                 exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,ref.index)))
  345.               else if (ref.base<>R_NO) and (ref.index=R_NO) and
  346.                  (ref.offset=0) and (ref.symbol=nil) then
  347.                 exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,ref.base)))
  348.               else
  349.                 begin
  350.                    exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(ref),R_EDI)));
  351.                    exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EDI)));
  352.                 end;
  353.            end;
  354.         end;
  355.  
  356.     procedure swaptree(p:Ptree);
  357.  
  358.     var swapp:Ptree;
  359.  
  360.     begin
  361.         swapp:=p^.right;
  362.         p^.right:=p^.left;
  363.         p^.left:=swapp;
  364.         p^.swaped:=not(p^.swaped);
  365.     end;
  366.  
  367.     procedure concatcopy(source,dest : treference;size : longint;delsource : boolean);
  368.  
  369.       const
  370.          isizes : array[0..3] of topsize=(S_L,S_B,S_W,S_B);
  371.          ishr : array[0..3] of byte=(2,0,1,0);
  372.  
  373.       var
  374.          ecxpushed : boolean;
  375.          helpsize : longint;
  376.          i : byte;
  377.          reg8,reg32 : tregister;
  378.          swap : boolean;
  379.  
  380.       begin
  381.          if delsource then
  382.            del_reference(source);
  383.  
  384.          if (size<=8) or (not(cs_littlesize in aktswitches ) and (size<=12)) then
  385.            begin
  386.               helpsize:=size shr 2;
  387.               for i:=1 to helpsize do
  388.                 begin
  389.                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(source),R_EDI)));
  390.                    exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,newreference(dest))));
  391.                    inc(source.offset,4);
  392.                    inc(dest.offset,4);
  393.                    dec(size,4);
  394.                 end;
  395.               if size>1 then
  396.                 begin
  397.                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_W,newreference(source),R_DI)));
  398.                    exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_W,R_DI,newreference(dest))));
  399.                    inc(source.offset,2);
  400.                    inc(dest.offset,2);
  401.                    dec(size,2);
  402.                 end;
  403.               if size>0 then
  404.                 begin
  405.  
  406.                    { and now look for an 8 bit register }
  407.                    swap:=false;
  408.                    if R_EAX in unused then reg8:=R_AL
  409.                    else if R_EBX in unused then reg8:=R_BL
  410.                    else if R_ECX in unused then reg8:=R_CL
  411.                    else if R_EDX in unused then reg8:=R_DL
  412.                    else
  413.                       begin
  414.                          swap:=true;
  415.  
  416.                          { we need only to check 3 registers, because }
  417.                          { one is always not index or base            }
  418.                          if (dest.base<>R_EAX) and (dest.index<>R_EAX) then
  419.                            begin
  420.                               reg8:=R_AL;
  421.                               reg32:=R_EAX;
  422.                            end
  423.                          else if (dest.base<>R_EBX) and (dest.index<>R_EBX) then
  424.                            begin
  425.                               reg8:=R_BL;
  426.                               reg32:=R_EBX;
  427.                            end
  428.                          else if (dest.base<>R_ECX) and (dest.index<>R_ECX) then
  429.                            begin
  430.                               reg8:=R_CL;
  431.                               reg32:=R_ECX;
  432.                            end;
  433.                       end;
  434.                    if swap then
  435.                      { was earlier XCHG, of course nonsense }
  436.                      emit_reg_reg(A_MOV,S_L,reg32,R_EDI);
  437.                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_B,newreference(source),reg8)));
  438.                    exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_B,reg8,newreference(dest))));
  439.                    if swap then
  440.                      emit_reg_reg(A_MOV,S_L,R_EDI,reg32);
  441.                 end;
  442.            end
  443.          else
  444.            begin
  445.               exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(dest),R_EDI)));
  446.               exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(source),R_ESI)));
  447.               if not(R_ECX in unused) then
  448.                 begin
  449.                    exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ECX)));
  450.                    ecxpushed:=true;
  451.                 end
  452.               else ecxpushed:=false;
  453.               exprasmlist^.concat(new(pai386,op_none(A_CLD,S_NO)));
  454.               if cs_littlesize in aktswitches  then
  455.                 begin
  456.                    exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_L,size shr ishr[size and 3],R_ECX)));
  457.                    exprasmlist^.concat(new(pai386,op_none(A_REP,S_NO)));
  458.                    exprasmlist^.concat(new(pai386,op_none(A_MOVS,isizes[size and 3])));
  459.                 end
  460.               else
  461.                 begin
  462.                    helpsize:=size-size and 3;
  463.                    size:=size and 3;
  464.                    exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_L,helpsize shr 2,R_ECX)));
  465.                    exprasmlist^.concat(new(pai386,op_none(A_REP,S_NO)));
  466.                    exprasmlist^.concat(new(pai386,op_none(A_MOVS,S_L)));
  467.                    if size>1 then
  468.                      begin
  469.                         dec(size,2);
  470.                         exprasmlist^.concat(new(pai386,op_none(A_MOVS,S_W)));
  471.                      end;
  472.                    if size=1 then
  473.                      exprasmlist^.concat(new(pai386,op_none(A_MOVS,S_B)));
  474.                 end;
  475.               if ecxpushed then
  476.                 exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_ECX)));
  477.  
  478.               { loading SELF-reference again }
  479.               maybe_loadesi;
  480.  
  481.               if delsource then
  482.                 ungetiftemp(source);
  483.            end;
  484.       end;
  485.  
  486.  
  487.     procedure emitloadord2reg(location:Tlocation;orddef:Porddef;
  488.                               destreg:Tregister;delloc:boolean);
  489.  
  490.     {A lot smaller and less bug sensitive than the original unfolded loads.}
  491.  
  492.     var tai:Pai386;
  493.         r:Preference;
  494.  
  495.     begin
  496.         case location.loc of
  497.             LOC_REGISTER,LOC_CREGISTER:
  498.                 begin
  499.                     case orddef^.typ of
  500.                         u8bit:
  501.                             tai:=new(pai386,op_reg_reg(A_MOVZX,S_BL,location.register,destreg));
  502.                         s8bit:
  503.                             tai:=new(pai386,op_reg_reg(A_MOVSX,S_BL,location.register,destreg));
  504.                         u16bit:
  505.                             tai:=new(pai386,op_reg_reg(A_MOVZX,S_WL,location.register,destreg));
  506.                         s16bit:
  507.                             tai:=new(pai386,op_reg_reg(A_MOVSX,S_WL,location.register,destreg));
  508.                         u32bit:
  509.                             tai:=new(pai386,op_reg_reg(A_MOV,S_L,location.register,destreg));
  510.                         s32bit:
  511.                             tai:=new(pai386,op_reg_reg(A_MOV,S_L,location.register,destreg));
  512.                     end;
  513.                     if delloc then
  514.                         ungetregister(location.register);
  515.                 end;
  516.             LOC_REFERENCE:
  517.                 begin
  518.                     r:=newreference(location.reference);
  519.                     case orddef^.typ of
  520.                         u8bit:
  521.                             tai:=new(pai386,op_ref_reg(A_MOVZX,S_BL,r,destreg));
  522.                         s8bit:
  523.                             tai:=new(pai386,op_ref_reg(A_MOVSX,S_BL,r,destreg));
  524.                         u16bit:
  525.                             tai:=new(pai386,op_ref_reg(A_MOVZX,S_WL,r,destreg));
  526.                         s16bit:
  527.                             tai:=new(pai386,op_ref_reg(A_MOVSX,S_WL,r,destreg));
  528.                         u32bit:
  529.                             tai:=new(pai386,op_ref_reg(A_MOV,S_L,r,destreg));
  530.                         s32bit:
  531.                             tai:=new(pai386,op_ref_reg(A_MOV,S_L,r,destreg));
  532.                     end;
  533.                     if delloc then
  534.                         del_reference(location.reference);
  535.                 end
  536.             else
  537.                 internalerror(6);
  538.         end;
  539.         exprasmlist^.concat(tai);
  540.     end;
  541.  
  542.     { if necessary ESI is reloaded after a call}
  543.     procedure maybe_loadesi;
  544.  
  545.       var
  546.          hp : preference;
  547.          p : pprocinfo;
  548.          i : longint;
  549.  
  550.       begin
  551.          if assigned(procinfo._class) then
  552.            begin
  553.               if lexlevel>2 then
  554.                 begin
  555.                    new(hp);
  556.                    reset_reference(hp^);
  557.                    hp^.offset:=procinfo.framepointer_offset;
  558.                    hp^.base:=procinfo.framepointer;
  559.                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,R_ESI)));
  560.                    p:=procinfo.parent;
  561.                    for i:=3 to lexlevel-1 do
  562.                      begin
  563.                         new(hp);
  564.                         reset_reference(hp^);
  565.                         hp^.offset:=p^.framepointer_offset;
  566.                         hp^.base:=R_ESI;
  567.                         exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,R_ESI)));
  568.                         p:=p^.parent;
  569.                      end;
  570.                    new(hp);
  571.                    reset_reference(hp^);
  572.                    hp^.offset:=p^.ESI_offset;
  573.                    hp^.base:=R_ESI;
  574.                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,R_ESI)));
  575.                 end
  576.               else
  577.                 begin
  578.                    new(hp);
  579.                    reset_reference(hp^);
  580.                    hp^.offset:=procinfo.ESI_offset;
  581.                    hp^.base:=procinfo.framepointer;
  582.                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,R_ESI)));
  583.                 end;
  584.            end;
  585.       end;
  586.  
  587.     procedure floatloadops(t : tfloattype;var op : tasmop;var s : topsize);
  588.  
  589.       begin
  590.          case t of
  591.             s32real : begin
  592.                          op:=A_FLD;
  593.                          s:=S_S;
  594.                       end;
  595.             s64real : begin
  596.                          op:=A_FLD;
  597.                          { ???? }
  598.                          s:=S_L;
  599.                       end;
  600.             s80real : begin
  601.                          op:=A_FLD;
  602.                          { this made a problem }
  603.                          { s:=S_Q;}
  604.                          s:=S_X;
  605.                       end;
  606.             s64bit : begin
  607.                          op:=A_FILD;
  608.                          s:=S_Q;
  609.                       end;
  610.             else internalerror(17);
  611.          end;
  612.       end;
  613.  
  614.     procedure floatload(t : tfloattype;const ref : treference);
  615.  
  616.       var
  617.          op : tasmop;
  618.          s : topsize;
  619.  
  620.       begin
  621.          floatloadops(t,op,s);
  622.          exprasmlist^.concat(new(pai386,op_ref(op,s,
  623.            newreference(ref))));
  624.       end;
  625.  
  626.     procedure floatstoreops(t : tfloattype;var op : tasmop;var s : topsize);
  627.  
  628.       begin
  629.          case t of
  630.             s32real : begin
  631.                          op:=A_FSTP;
  632.                          s:=S_S;
  633.                       end;
  634.             s64real : begin
  635.                          op:=A_FSTP;
  636.                          s:=S_L;
  637.                       end;
  638.             s80real : begin
  639.                          op:=A_FSTP;
  640.                          { this made a problem }
  641.                          { s:=S_Q;}
  642.                           s:=S_X;
  643.                       end;
  644.             s64bit : begin
  645.                          op:=A_FISTP;
  646.                          s:=S_Q;
  647.                       end;
  648.             else internalerror(17);
  649.          end;
  650.       end;
  651.  
  652.     procedure floatstore(t : tfloattype;const ref : treference);
  653.  
  654.       var
  655.          op : tasmop;
  656.          s : topsize;
  657.  
  658.       begin
  659.          floatstoreops(t,op,s);
  660.          exprasmlist^.concat(new(pai386,op_ref(op,s,
  661.            newreference(ref))));
  662.       end;
  663.  
  664.     procedure firstcomplex(p : ptree);
  665.  
  666.       var
  667.          hp : ptree;
  668.  
  669.       begin
  670.          { always calculate boolean AND and OR from left to right }
  671.          if ((p^.treetype=orn) or (p^.treetype=andn)) and
  672.            (p^.left^.resulttype^.deftype=orddef) and
  673.            (porddef(p^.left^.resulttype)^.typ=bool8bit) then
  674.            p^.swaped:=false
  675.          else if (p^.left^.registers32<p^.right^.registers32)
  676.  
  677.            { the following check is appropriate, because all }
  678.            { 4 registers are rarely used and it is thereby   }
  679.            { achieved that the extra code is being dropped   }
  680.            { by exchanging not commutative operators         }
  681.            and (p^.right^.registers32<=4) then
  682.            begin
  683.               hp:=p^.left;
  684.               p^.left:=p^.right;
  685.               p^.right:=hp;
  686.               p^.swaped:=true;
  687.            end
  688.          else p^.swaped:=false;
  689.       end;
  690.  
  691.     procedure secondfuncret(var p : ptree);
  692.  
  693.       var
  694.          hregister : tregister;
  695.  
  696.       begin
  697.          clear_reference(p^.location.reference);
  698. {$ifndef TEST_FUNCRET}
  699.          p^.location.reference.base:=procinfo.framepointer;
  700.          p^.location.reference.offset:=procinfo.retoffset;
  701.          if ret_in_param(procinfo.retdef) then
  702. {$else TEST_FUNCRET}
  703.          if @procinfo<>pprocinfo(p^.funcretprocinfo) then
  704.            begin
  705.               { walk up the stack frame }
  706.               { not done yet !! }
  707.            end
  708.          else
  709.            p^.location.reference.base:=pprocinfo(p^.funcretprocinfo)^.framepointer;
  710.          p^.location.reference.offset:=pprocinfo(p^.funcretprocinfo)^.retoffset;
  711.          if ret_in_param(p^.retdef) then
  712. {$endif TEST_FUNCRET}
  713.            begin
  714.               hregister:=getregister32;
  715.               exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.location.reference),hregister)));
  716.               p^.location.reference.base:=hregister;
  717.               p^.location.reference.offset:=0;
  718.            end;
  719.       end;
  720.  
  721.     procedure codegen_newprocedure;
  722.  
  723.       begin
  724.          aktbreaklabel:=nil;
  725.          aktcontinuelabel:=nil;
  726.          { aktexitlabel:=0; is store in oldaktexitlabel
  727.            so it must not be reset to zero before this storage !}
  728.  
  729.          { the type of this lists isn't important }
  730.          { because the code of this lists is      }
  731.          { copied to the code segment             }
  732.          procinfo.aktentrycode:=new(paasmoutput,init);
  733.          procinfo.aktexitcode:=new(paasmoutput,init);
  734.          procinfo.aktproccode:=new(paasmoutput,init);
  735.       end;
  736.  
  737.     procedure codegen_doneprocedure;
  738.  
  739.       begin
  740.          dispose(procinfo.aktentrycode,done);
  741.          dispose(procinfo.aktexitcode,done);
  742.          dispose(procinfo.aktproccode,done);
  743.       end;
  744.  
  745.     procedure codegen_newmodule;
  746.  
  747.       begin
  748.          exprasmlist:=new(paasmoutput,init);
  749.       end;
  750.  
  751.     procedure codegen_donemodule;
  752.  
  753.       begin
  754.          dispose(exprasmlist,done);
  755.          dispose(codesegment,done);
  756.          dispose(bsssegment,done);
  757.          dispose(datasegment,done);
  758.          dispose(debuglist,done);
  759.          dispose(externals,done);
  760.          dispose(consts,done);
  761.       end;
  762.  
  763.  
  764.   procedure genprofilecode;
  765.     var
  766.       pl : plabel;
  767.     begin
  768.       case target_info.target of
  769.          target_linux:
  770.            begin
  771.               getlabel(pl);
  772.               procinfo.aktentrycode^.insert(new(pai386,op_csymbol
  773.                  (A_CALL,S_NO,newcsymbol('mcount',0))));
  774.               procinfo.aktentrycode^.insert(new(pai386,op_csymbol_reg
  775.                  (A_MOV,S_L,newcsymbol(lab2str(pl),0),R_EDX)));
  776.               procinfo.aktentrycode^.insert(new(pai_direct,init(
  777.                  strpnew('.text'))));
  778.               procinfo.aktentrycode^.insert(new(pai_const,init_32bit(0)));
  779.               procinfo.aktentrycode^.insert(new(pai_label,init(pl)));
  780.               procinfo.aktentrycode^.insert(new(pai_align,init(4)));
  781.               procinfo.aktentrycode^.insert(new(pai_direct,init(
  782.                  strpnew('.data'))));
  783.               concat_external('mcount',EXT_NEAR);
  784.            end;
  785.          target_go32v2:
  786.            begin
  787.               procinfo.aktentrycode^.insert(new(pai386,op_csymbol
  788.                  (A_CALL,S_NO,newcsymbol('MCOUNT',0))));
  789.               concat_external('MCOUNT',EXT_NEAR);
  790.            end;
  791.       end;
  792.     end;                
  793.  
  794.  
  795.   procedure genentrycode(const proc_names:Tstringcontainer;make_global:boolean;
  796.                          stackframe:longint;
  797.                          var parasize:longint;var nostackframe:boolean);
  798.  
  799.   {Generates the entry code for a procedure.}
  800.  
  801.   var hs:string;
  802.       hp:Pused_unit;
  803.       unitinits:taasmoutput;
  804.   {$ifdef GDB}
  805.       {oldaktprocname : string;}
  806.       stab_function_name:Pai_stab_function_name;
  807.   {$endif GDB}
  808.  
  809.  
  810.   begin
  811.       if (aktprocsym^.definition^.options and poproginit)<>0 then
  812.           begin
  813.               {Init the stack checking.}
  814.               if (cs_check_stack in aktswitches) and
  815.                (target_info.target=target_linux) then
  816.                   begin
  817.                       procinfo.aktentrycode^.insert(new(pai386,
  818.                        op_csymbol(A_CALL,S_NO,newcsymbol('INIT_STACK_CHECK',0))));
  819.                   end;
  820.  
  821.               unitinits.init;
  822.  
  823.               {Call the unit init procedures.}
  824.               hp:=pused_unit(usedunits.first);
  825.               while assigned(hp) do
  826.                 begin
  827.                    { call the unit init code and make it external }
  828.                    if (hp^.u^.flags and uf_init)<>0 then
  829.                      begin
  830.                         unitinits.concat(new(pai386,op_csymbol(A_CALL,S_NO,newcsymbol('INIT$$'+hp^.u^.unitname^,0))));
  831.                         externals^.concat(new(pai_external,init('INIT$$'+hp^.u^.unitname^,EXT_NEAR)));
  832.                      end;
  833.                     hp:=Pused_unit(hp^.next);
  834.                 end;
  835.               procinfo.aktentrycode^.insertlist(@unitinits);
  836.               unitinits.done;
  837.           end;
  838.  
  839.           { a constructor needs a help procedure }
  840.           if (aktprocsym^.definition^.options and poconstructor)<>0 then
  841.             begin
  842.               if procinfo._class^.isclass then
  843.                 begin
  844.                   procinfo.aktentrycode^.insert(new(pai_labeled,init(A_JZ,quickexitlabel)));
  845.                   procinfo.aktentrycode^.insert(new(pai386,op_csymbol(A_CALL,S_NO,
  846.                     newcsymbol('NEW_CLASS',0))));
  847.                   concat_external('NEW_CLASS',EXT_NEAR);
  848.                 end
  849.               else
  850.                 begin
  851.                   procinfo.aktentrycode^.insert(new(pai_labeled,init(A_JZ,quickexitlabel)));
  852.                   procinfo.aktentrycode^.insert(new(pai386,op_csymbol(A_CALL,S_NO,
  853.                     newcsymbol('HELP_CONSTRUCTOR',0))));
  854.                   concat_external('HELP_CONSTRUCTOR',EXT_NEAR);
  855.                 end;
  856.             end;
  857.  
  858.       { don't load ESI, does the caller }
  859.  
  860.       { omit stack frame ? }
  861.       if procinfo.framepointer=stack_pointer then
  862.           begin
  863.               Message(cg_d_stackframe_omited);
  864.               nostackframe:=true;
  865.               if (aktprocsym^.definition^.options and (pounitinit or poproginit)<>0) then
  866.                 parasize:=0
  867.               else
  868.                 parasize:=aktprocsym^.definition^.parast^.datasize+procinfo.call_offset;
  869.           end
  870.       else
  871.           begin
  872.               if (aktprocsym^.definition^.options and (pounitinit or poproginit)<>0) then
  873.                 parasize:=0
  874.               else
  875.                 parasize:=aktprocsym^.definition^.parast^.datasize+procinfo.call_offset-8;
  876.               nostackframe:=false;
  877.               if stackframe<>0 then
  878.                   begin
  879.                       if (cs_littlesize in aktswitches) and (stackframe<=65535) then
  880.                           begin
  881.                               if (cs_check_stack in aktswitches) and
  882.                                (target_info.target<>target_linux) then
  883.                                   begin
  884.                                       procinfo.aktentrycode^.insert(new(pai386,
  885.                                        op_csymbol(A_CALL,S_NO,newcsymbol('STACKCHECK',0))));
  886.                                       procinfo.aktentrycode^.insert(new(pai386,op_const(A_PUSH,S_L,stackframe)));
  887.                                   end;
  888.                               if cs_profile in aktswitches then
  889.                                genprofilecode;
  890.  
  891.                               if (target_info.target=target_linux) and
  892.                                ((aktprocsym^.definition^.options and poexports)<>0) then
  893.                                   procinfo.aktentrycode^.insert(new(Pai386,op_reg(A_PUSH,S_L,R_EDI)));
  894.  
  895.                               procinfo.aktentrycode^.insert(new(pai386,op_const_const(A_ENTER,S_NO,stackframe,0)))
  896.                           end
  897.                       else
  898.                           begin
  899.                               procinfo.aktentrycode^.insert(new(pai386,op_const_reg(A_SUB,S_L,stackframe,R_ESP)));
  900.                               if (cs_check_stack in aktswitches) and (target_info.target<>target_linux) then
  901.                                 begin
  902.                                    procinfo.aktentrycode^.insert(new(pai386,
  903.                                      op_csymbol(A_CALL,S_NO,newcsymbol('STACKCHECK',0))));
  904.                                    procinfo.aktentrycode^.insert(new(pai386,op_const(A_PUSH,S_L,stackframe)));
  905.                                    concat_external('STACKCHECK',EXT_NEAR);
  906.                                 end;
  907.                               if cs_profile in aktswitches then
  908.                                genprofilecode;
  909.                               procinfo.aktentrycode^.insert(new(pai386,op_reg_reg(A_MOV,S_L,R_ESP,R_EBP)));
  910.                               procinfo.aktentrycode^.insert(new(pai386,op_reg(A_PUSH,S_L,R_EBP)));
  911.                           end;
  912.                   end { endif stackframe <> 0 }
  913.               else
  914.                  begin
  915.                    if cs_profile in aktswitches then
  916.                      genprofilecode;
  917.                    procinfo.aktentrycode^.insert(new(pai386,op_reg_reg(A_MOV,S_L,R_ESP,R_EBP)));
  918.                    procinfo.aktentrycode^.insert(new(pai386,op_reg(A_PUSH,S_L,R_EBP)));
  919.                  end;
  920.           end;
  921.  
  922. {              if cs_profile in aktswitches then
  923.                   procinfo.aktentrycode^.insert(new(pai386,op_csymbol(A_CALL,S_NO,newcsymbol('MCOUNT',0))));
  924.               if (target_info.target=target_linux) and
  925.                ((aktprocsym^.definition^.options and poexports)<>0) then
  926.                   procinfo.aktentrycode^.insert(new(Pai386,op_reg(A_PUSH,S_L,R_EDI))); !!!}
  927.  
  928.       if (aktprocsym^.definition^.options and pointerrupt)<>0 then
  929.           generate_interrupt_stackframe_entry;
  930.  
  931.       if (cs_profile in aktswitches) or
  932.          (aktprocsym^.definition^.owner^.symtabletype=globalsymtable) or
  933.          ((procinfo._class<>nil) and (procinfo._class^.owner^.symtabletype=globalsymtable)) then
  934.            make_global:=true;
  935.       hs:=proc_names.get;
  936.  
  937.   {$IfDef GDB}
  938.       if (cs_debuginfo in aktswitches) and
  939.        target_info.use_function_relative_addresses then
  940.           stab_function_name := new(pai_stab_function_name,init(strpnew(hs)));
  941.       { oldaktprocname:=aktprocsym^.name;}
  942.   {$EndIf GDB}
  943.  
  944.       while hs<>'' do
  945.           begin
  946.               if make_global then
  947.                 procinfo.aktentrycode^.insert(new(pai_symbol,init_global(hs)))
  948.               else
  949.                 procinfo.aktentrycode^.insert(new(pai_symbol,init(hs)));
  950.  
  951.   {$ifdef GDB}
  952.               if (cs_debuginfo in aktswitches) then
  953.                begin
  954.                  if target_info.use_function_relative_addresses then
  955.                   procinfo.aktentrycode^.insert(new(pai_stab_function_name,init(strpnew(hs))));
  956.  
  957.               { This is not a nice solution to save the name, change it and restore when done }
  958.               { not only not nice but also completely wrong !!! (PM) }
  959.               {   aktprocsym^.setname(hs);
  960.                  procinfo.aktentrycode^.insert(new(pai_stabs,init(aktprocsym^.stabstring))); }
  961.                end;
  962.   {$endif GDB}
  963.  
  964.               hs:=proc_names.get;
  965.           end;
  966.  
  967.   {$ifdef GDB}
  968.       {aktprocsym^.setname(oldaktprocname);}
  969.  
  970.       if (cs_debuginfo in aktswitches) then
  971.           begin
  972.               if target_info.use_function_relative_addresses then
  973.                   procinfo.aktentrycode^.insert(stab_function_name);
  974.               if make_global or ((procinfo.flags and pi_is_global) <> 0) then
  975.                   aktprocsym^.is_global := True;
  976.               {This is dead code! Because lexlevel is increased at the
  977.                start of this procedure it can never be zero.}
  978.   {           if (lexlevel > 1) and (oldprocsym^.definition^.localst^.name = nil) then
  979.                   if oldprocsym^.owner^.symtabletype = objectsymtable then
  980.                       oldprocsym^.definition^.localst^.name := stringdup(oldprocsym^.owner^.name^+'_'+oldprocsym^.name)
  981.                   else
  982.                       oldprocsym^.definition^.localst^.name := stringdup(oldprocsym^.name);}
  983.               procinfo.aktentrycode^.insert(new(pai_stabs,init(aktprocsym^.stabstring)));
  984.               aktprocsym^.isstabwritten:=true;
  985.           end;
  986.       { !!!!!! }
  987.       { gprof uses 16 byte granularity !! }
  988.       { space is filled with NOP 0x90     }
  989.       if not(cs_littlesize in aktswitches) then
  990.        begin
  991.          if (cs_profile in aktswitches) then
  992.           procinfo.aktentrycode^.insert(new(pai_align,init_op(16,$90)))
  993.          else
  994.           procinfo.aktentrycode^.insert(new(pai_align,init(4)));
  995.        end;     
  996.   {$endif GDB}
  997.   {$ifdef EXTDEBUG}
  998.     procinfo.aktentrycode^.insert(new(pai_direct,init(strpnew(target_info.newline))));
  999.   {$endif EXTDEBUG}
  1000.   end;
  1001.  
  1002.   procedure genexitcode(parasize:longint;nostackframe:boolean);
  1003.  
  1004.   var hr:Preference;          {This is for function results.}
  1005.       op:Tasmop;
  1006.       s:Topsize;
  1007.  
  1008.  
  1009.   begin
  1010.       { !!!! insert there automatic destructors }
  1011.       procinfo.aktexitcode^.insert(new(pai_label,init(aktexitlabel)));
  1012.  
  1013.       { call the destructor help procedure }
  1014.       if (aktprocsym^.definition^.options and podestructor)<>0 then
  1015.         begin
  1016.           if procinfo._class^.isclass then
  1017.             begin
  1018.               procinfo.aktexitcode^.insert(new(pai386,op_csymbol(A_CALL,S_NO,
  1019.                 newcsymbol('DISPOSE_CLASS',0))));
  1020.               concat_external('DISPOSE_CLASS',EXT_NEAR);
  1021.             end
  1022.           else
  1023.             begin
  1024.               procinfo.aktexitcode^.insert(new(pai386,op_csymbol(A_CALL,S_NO,
  1025.                 newcsymbol('HELP_DESTRUCTOR',0))));
  1026.               concat_external('HELP_DESTRUCTOR',EXT_NEAR);
  1027.             end;
  1028.         end;
  1029.  
  1030.       { call __EXIT for main program }
  1031.       if (aktprocsym^.definition^.options and poproginit)<>0 then
  1032.        begin
  1033.          procinfo.aktexitcode^.concat(new(pai386,op_csymbol(A_CALL,S_NO,newcsymbol('__EXIT',0))));
  1034.          externals^.concat(new(pai_external,init('__EXIT',EXT_NEAR)));
  1035.        end;
  1036.  
  1037.       { handle return value }
  1038.       if (aktprocsym^.definition^.options and poassembler)=0 then
  1039.           if (aktprocsym^.definition^.options and poconstructor)=0 then
  1040.               begin
  1041.                   if procinfo.retdef<>pdef(voiddef) then
  1042.                       begin
  1043.                           if not(procinfo.funcret_is_valid) and
  1044.                             ((procinfo.flags and pi_uses_asm)=0) then
  1045.                            Message(sym_w_function_result_not_set);
  1046.                           new(hr);
  1047.                           reset_reference(hr^);
  1048.                           hr^.offset:=procinfo.retoffset;
  1049.                           hr^.base:=procinfo.framepointer;
  1050.                           if (procinfo.retdef^.deftype=orddef) then
  1051.                               begin
  1052.                                   case porddef(procinfo.retdef)^.typ of
  1053.                                       s32bit,u32bit :
  1054.                                           procinfo.aktexitcode^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hr,R_EAX)));
  1055.                                       u8bit,s8bit,uchar,bool8bit :
  1056.                                           procinfo.aktexitcode^.concat(new(pai386,op_ref_reg(A_MOV,S_B,hr,R_AL)));
  1057.                                       s16bit,u16bit :
  1058.                                           procinfo.aktexitcode^.concat(new(pai386,op_ref_reg(A_MOV,S_W,hr,R_AX)));
  1059.                                   end;
  1060.                               end
  1061.                           else
  1062.                               if (procinfo.retdef^.deftype in [pointerdef,enumdef,procvardef]) or
  1063.                                ((procinfo.retdef^.deftype=setdef) and
  1064.                                (psetdef(procinfo.retdef)^.settype=smallset)) then
  1065.                                   procinfo.aktexitcode^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hr,R_EAX)))
  1066.                               else
  1067.                                   if (procinfo.retdef^.deftype=floatdef) then
  1068.                                       begin
  1069.                                           if pfloatdef(procinfo.retdef)^.typ=f32bit then
  1070.                                               begin
  1071.                                                   { Isnt this missing ? }
  1072.                                                   procinfo.aktexitcode^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hr,R_EAX)));
  1073.                                               end
  1074.                                           else
  1075.                                               begin
  1076.                                                   floatloadops(pfloatdef(procinfo.retdef)^.typ,op,s);
  1077.                                                   procinfo.aktexitcode^.concat(new(pai386,op_ref(op,s,hr)))
  1078.                                               end
  1079.                                       end
  1080.                                   else
  1081.                                       dispose(hr);
  1082.                       end
  1083.               end
  1084.           else
  1085.               begin
  1086.                   { successful constructor deletes the zero flag }
  1087.                   { and returns self in eax                      }
  1088.                   procinfo.aktexitcode^.concat(new(pai_label,init(quickexitlabel)));
  1089.                   { eax must be set to zero if the allocation failed !!! }
  1090.                   procinfo.aktexitcode^.concat(new(pai386,op_reg_reg(A_MOV,S_L,R_ESI,R_EAX)));
  1091.                   procinfo.aktexitcode^.concat(new(pai386,op_reg_reg(A_OR,S_L,R_EAX,R_EAX)));
  1092.               end;
  1093.       procinfo.aktexitcode^.concat(new(pai_label,init(aktexit2label)));
  1094.       if (target_info.target=target_linux) and
  1095.        ((aktprocsym^.definition^.options and poexports)<>0) then
  1096.           procinfo.aktentrycode^.insert(new(Pai386,op_reg(A_POP,S_L,R_EDI)));
  1097.       if not(nostackframe) then
  1098.           procinfo.aktexitcode^.concat(new(pai386,op_none(A_LEAVE,S_NO)));
  1099.       { parameters are limited to 65535 bytes because }
  1100.       { ret allows only imm16                         }
  1101.       if parasize>65535 then
  1102.        Message(cg_e_parasize_too_big);
  1103.  
  1104.       { at last, the return is generated }
  1105.  
  1106.       if (aktprocsym^.definition^.options and pointerrupt)<>0 then
  1107.           generate_interrupt_stackframe_exit
  1108.       else
  1109.        begin
  1110.        {Routines with the poclearstack flag set use only a ret.}
  1111.        { also routines with parasize=0           }
  1112.          if (parasize=0) or (aktprocsym^.definition^.options and poclearstack<>0) then
  1113.           procinfo.aktexitcode^.concat(new(pai386,op_none(A_RET,S_NO)))
  1114.          else
  1115.           procinfo.aktexitcode^.concat(new(pai386,op_const(A_RET,S_NO,parasize)));
  1116.        end;
  1117.  
  1118.   {$ifdef GDB}
  1119.       if cs_debuginfo in aktswitches  then
  1120.           begin
  1121.               aktprocsym^.concatstabto(procinfo.aktexitcode);
  1122.               if assigned(procinfo._class) then
  1123.                   procinfo.aktexitcode^.concat(new(pai_stabs,init(strpnew(
  1124.                    '"$t:v'+procinfo._class^.numberstring+'",'+
  1125.                    tostr(N_PSYM)+',0,0,'+tostr(procinfo.esi_offset)))));
  1126.  
  1127.               if (porddef(aktprocsym^.definition^.retdef) <> voiddef) then
  1128.                   procinfo.aktexitcode^.concat(new(pai_stabs,init(strpnew(
  1129.                    '"'+aktprocsym^.name+':X'+aktprocsym^.definition^.retdef^.numberstring+'",'+
  1130.                    tostr(N_PSYM)+',0,0,'+tostr(procinfo.retoffset)))));
  1131.  
  1132.               procinfo.aktexitcode^.concat(new(pai_stabn,init(strpnew('192,0,0,'
  1133.                +aktprocsym^.definition^.mangledname))));
  1134.  
  1135.               procinfo.aktexitcode^.concat(new(pai_stabn,init(strpnew('224,0,0,'
  1136.                +lab2str(aktexit2label)))));
  1137.           end;
  1138.   {$endif GDB}
  1139.   end;
  1140.   end.
  1141. {
  1142.   $Log: cgai386.pas,v $
  1143.   Revision 1.4.2.1  1998/04/09 23:29:23  peter
  1144.     * fixed profiling
  1145.  
  1146.   Revision 1.4  1998/03/30 15:53:00  florian
  1147.     * last changes before release:
  1148.        - gdb fixed
  1149.        - ratti386 warning removed (about unset function result)
  1150.  
  1151.   Revision 1.3  1998/03/28 23:09:55  florian
  1152.     * secondin bugfix (m68k and i386)
  1153.     * overflow checking bugfix (m68k and i386) -- pretty useless in
  1154.       secondadd, since everything is done using 32-bit
  1155.     * loading pointer to routines hopefully fixed (m68k)
  1156.     * flags problem with calls to RTL internal routines fixed (still strcmp
  1157.       to fix) (m68k)
  1158.     * #ELSE was still incorrect (didn't take care of the previous level)
  1159.     * problem with filenames in the command line solved
  1160.     * problem with mangledname solved
  1161.     * linking name problem solved (was case insensitive)
  1162.     * double id problem and potential crash solved
  1163.     * stop after first error
  1164.     * and=>test problem removed
  1165.     * correct read for all float types
  1166.     * 2 sigsegv fixes and a cosmetic fix for Internal Error
  1167.     * push/pop is now correct optimized (=> mov (%esp),reg)
  1168.  
  1169.   Revision 1.2  1998/03/26 11:18:29  florian
  1170.     - switch -Sa removed
  1171.     - support of a:=b:=0 removed
  1172.  
  1173.   Revision 1.1.1.1  1998/03/25 11:18:16  root
  1174.   * Restored version
  1175.  
  1176.   Revision 1.23  1998/03/18 22:50:11  florian
  1177.     + fstp/fld optimization
  1178.     * routines which contains asm aren't longer optimzed
  1179.     * wrong ifdef TEST_FUNCRET corrected
  1180.     * wrong data generation for array[0..n] of char = '01234'; fixed
  1181.     * bug0097 is fixed partial
  1182.     * bug0116 fixed (-Og doesn't use enter of the stack frame is greater than
  1183.       65535)
  1184.  
  1185.   Revision 1.22  1998/03/16 22:42:18  florian
  1186.     * some fixes of Peter applied:
  1187.       ofs problem, profiler support
  1188.  
  1189.   Revision 1.21  1998/03/11 22:22:51  florian
  1190.     * Fixed circular unit uses, when the units are not in the current dir (from Peter)
  1191.     * -i shows correct info, not <lf> anymore (from Peter)
  1192.     * linking with shared libs works again (from Peter)
  1193.  
  1194.   Revision 1.20  1998/03/10 23:48:35  florian
  1195.     * a couple of bug fixes to get the compiler with -OGaxz compiler, sadly
  1196.       enough, it doesn't run
  1197.  
  1198.   Revision 1.19  1998/03/10 16:27:37  pierre
  1199.     * better line info in stabs debug
  1200.     * symtabletype and lexlevel separated into two fields of tsymtable
  1201.     + ifdef MAKELIB for direct library output, not complete
  1202.     + ifdef CHAINPROCSYMS for overloaded seach across units, not fully
  1203.       working
  1204.     + ifdef TESTFUNCRET for setting func result in underfunction, not
  1205.       working
  1206.  
  1207.   Revision 1.18  1998/03/10 01:17:16  peter
  1208.     * all files have the same header
  1209.     * messages are fully implemented, EXTDEBUG uses Comment()
  1210.     + AG... files for the Assembler generation
  1211.  
  1212.   Revision 1.17  1998/03/09 10:44:35  peter
  1213.     + string='', string<>'', string:='', string:=char optimizes (the first 2
  1214.       were already in cg68k2)
  1215.  
  1216.   Revision 1.16  1998/03/06 00:52:04  peter
  1217.     * replaced all old messages from errore.msg, only ExtDebug and some
  1218.       Comment() calls are left
  1219.     * fixed options.pas
  1220.  
  1221.   Revision 1.15  1998/03/04 01:34:51  peter
  1222.     * messages for unit-handling and assembler/linker
  1223.     * the compiler compiles without -dGDB, but doesn't work yet
  1224.     + -vh for Hint
  1225.  
  1226.   Revision 1.14  1998/03/03 23:18:44  florian
  1227.     * ret $8 problem with unit init/main program fixed
  1228.  
  1229.   Revision 1.13  1998/03/02 23:08:40  florian
  1230.     * the concatcopy bug removed (solves problems when compilg sysatari!)
  1231.  
  1232.   Revision 1.12  1998/03/02 01:48:18  peter
  1233.     * renamed target_DOS to target_GO32V1
  1234.     + new verbose system, merged old errors and verbose units into one new
  1235.       verbose.pas, so errors.pas is obsolete
  1236.  
  1237.   Revision 1.11  1998/03/01 22:46:01  florian
  1238.     + some win95 linking stuff
  1239.     * a couple of bugs fixed:
  1240.       bug0055,bug0058,bug0059,bug0064,bug0072,bug0093,bug0095,bug0098
  1241.  
  1242.   Revision 1.10  1998/02/13 10:34:46  daniel
  1243.   * Made Motorola version compilable.
  1244.   * Fixed optimizer
  1245.  
  1246.   Revision 1.9  1998/02/12 17:18:53  florian
  1247.     * fixed to get remake3 work, but needs additional fixes (output, I don't like
  1248.       also that aktswitches isn't a pointer)
  1249.  
  1250.   Revision 1.8  1998/02/12 11:49:51  daniel
  1251.   Yes! Finally! After three retries, my patch!
  1252.  
  1253.   Changes:
  1254.  
  1255.   Complete rewrite of psub.pas.
  1256.   Added support for DLL's.
  1257.   Compiler requires less memory.
  1258.   Platform units for each platform.
  1259.  
  1260.   Revision 1.7  1998/02/11 21:56:28  florian
  1261.     * bugfixes: bug0093, bug0053, bug0088, bug0087, bug0089
  1262.  
  1263.   Revision 1.6  1998/02/07 09:39:20  florian
  1264.     * correct handling of in_main
  1265.     + $D,$T,$X,$V like tp
  1266.  
  1267.   Revision 1.5  1998/01/07 00:16:41  michael
  1268.   Restored released version (plus fixes) as current
  1269.  
  1270.   Revision 1.4  1997/12/13 18:59:40  florian
  1271.   + I/O streams are now also declared as external, if neccessary
  1272.   * -Aobj generates now a correct obj file via nasm
  1273.  
  1274.   Revision 1.3  1997/12/09 13:30:51  carl
  1275.   + renamed some stuff
  1276.  
  1277.   Revision 1.2  1997/11/28 18:14:23  pierre
  1278.    working version with several bug fixes
  1279.  
  1280.   Revision 1.1.1.1  1997/11/27 08:32:54  michael
  1281.   FPC Compiler CVS start
  1282.  
  1283.  
  1284.   Pre-CVS log:
  1285.  
  1286.  
  1287.     6th november 1997:
  1288.      * replaced S_Q by S_T for s80real fld and fst (PM)
  1289.  
  1290. }
  1291.